/*
 * PySL:  Use S-Lang from Python (and vice versa)
 * Copyright (C) 2005,2006 Christopher J. Stawarz <chris@pseudogreen.org>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 */



#define _LIBPYSL_C
#include "libpysl.h"



/******************************************************************************
 *
 * String utilities
 *
 *****************************************************************************/



/*
 * Concatenate n char*'s and return the result.  The resulting string is
 * malloced and must be freed by the caller.
 */
char *
libpysl_strcatn(int n, ...)
{
  va_list argptr;
  char *str = NULL;
  char *buf = NULL;
  size_t buflen = 1;  /* Space for terminating '\0' */
  int i;

  /* Calculate length of result */
  va_start(argptr, n);
  for (i = 0; i < n; i++) {
    str = va_arg(argptr, char*);
    buflen += strlen(str);
  }
  va_end(argptr);

  /* Allocate and initialize buffer */
  if (NULL == (buf = malloc(buflen))) {
    PyErr_NoMemory();
    return NULL;
  }
  strcpy(buf, "");

  /* Build result */
  va_start(argptr, n);
  for (i = 0; i < n; i++) {
    str = va_arg(argptr, char*);
    strcat(buf, str);
  }
  va_end(argptr);

  return buf;
}


/*
 * Return name qualified by S-Lang namespace ns_name, e.g. "ns_name->name" if
 * ns_name is non-NULL, or simply "name" if ns_name is NULL.  The result is
 * malloced and must be freed by the caller.
 */
char *
libpysl_ns_qualify_name(char *name, char *ns_name)
{
  if (NULL == ns_name)
    return libpysl_strcatn(1, name);
  return libpysl_strcatn(3, ns_name, "->", name);
}



/******************************************************************************
 *
 * Error handling routines
 *
 *****************************************************************************/



/* Error objects/codes */
PyObject *PySL_SLangError = NULL;
int SLPy_PythonError = 0;


/* Error mappings */
PyObject *LibPySL_Py2SL_Error_Map = NULL;  /* Python to S-Lang */
PyObject *LibPySL_SL2Py_Error_Map = NULL;  /* S-Lang to Python */


void
libpysl_python_to_slang_error(void)
{
  PyObject *type = NULL;
  PyObject *value = NULL;
  PyObject *traceback = NULL;
  PyObject *slerr_obj = NULL;
  long slerr_long;
  int slerr = SLPy_PythonError;
  PyObject *type_str_obj = NULL;
  PyObject *value_str_obj = NULL;
  char *type_str_full = NULL;
  char *type_str = NULL;
  char *value_str = NULL;

  PyErr_Fetch(&type, &value, &traceback);

  /* If there's no Python exception to convert and a S-Lang error is already
   * set, we don't need to do anything */
  if ((NULL == type) && SLang_get_error())
    return;

  if (NULL != type &&
      NULL != (slerr_obj = PyDict_GetItem(LibPySL_Py2SL_Error_Map, type))) {
    slerr_long = PyInt_AsLong(slerr_obj);
    if (NULL != PyErr_Occurred())
      PyErr_Clear();
    else if (SAFE_TO_CAST(slerr_long, long, int))
      slerr = (int)slerr_long;
  }

  if (NULL != value) {
    if (NULL == (value_str_obj = PyObject_Str(value)))
      PyErr_Clear();
    else
      value_str = PyString_AsString(value_str_obj);
  }

  if (slerr != SLPy_PythonError) {

    /* Map to a user-specified S-Lang error */
    
    if (NULL == value_str)
      SLang_verror(slerr, "");
    else
      SLang_verror(slerr, value_str);

  } else {

    /* Generic mapping to SLPy_PythonError */

    if (NULL != type) {
      if (NULL == (type_str_obj = PyObject_Str(type)))
	PyErr_Clear();
      else {
	type_str_full = PyString_AsString(type_str_obj);
	type_str = strrchr(type_str_full, '.');
	if (NULL == type_str)
	  type_str = type_str_full;
	else
	  type_str++;
      }
    }

    if (NULL == type_str)
      SLang_verror(slerr, "");
    else if (NULL == value_str)
      SLang_verror(slerr, type_str);
    else
      SLang_verror(slerr, "%s: %s", type_str, value_str);

  }

  Py_XDECREF(type);
  Py_XDECREF(value);
  Py_XDECREF(traceback);
  Py_XDECREF(type_str_obj);
  Py_XDECREF(value_str_obj);
}


void
libpysl_slang_to_python_error(void)
{
  int slerr = SLang_get_error();
  PyObject *slerr_obj = NULL;
  PyObject *pyerr = NULL;

  if (libpysl_python_is_toplevel())  SLang_restart(1);
  SLang_set_error(0);

  /* If a Python exception is already set, we don't need to do anything */
  if (NULL != PyErr_Occurred())
    return;

  if (NULL == (slerr_obj = PyInt_FromLong((long)slerr)))
    PyErr_Clear();
  else {
    if (NULL == (pyerr = PyDict_GetItem(LibPySL_SL2Py_Error_Map, slerr_obj)) ||
	!PyExceptionClass_Check(pyerr))
      pyerr = PySL_SLangError;
    Py_DECREF(slerr_obj);
  }

  if (pyerr != PySL_SLangError) {

    /* Map to a user-specified Python exception */
    PyErr_SetNone(pyerr);

  } else {

    /* Generic mapping to PySL_SLangError */
    PyErr_SetString(pyerr, SLerr_strerror(slerr));

  }
}



/******************************************************************************
 *
 * Python SLangObject type
 *
 *****************************************************************************/



/* Pointers to needed S-Lang functions */
static SLang_Name_Type *libpysl_slfunc_assoc_get_keys = NULL;
static SLang_Name_Type *libpysl_slfunc_length = NULL;
static SLang_Name_Type *libpysl_slfunc_string = NULL;


typedef struct {
  PyObject_HEAD
  SLang_Any_Type *obj;
} PySL_SLangObject_Object;


static void
pysl_slangobject_dealloc(PySL_SLangObject_Object *self)
{
  /* I'm almost certain this is okay; it looks like pushing or popping an
   * anytype always results in a new object being created */
  SLang_free_anytype(self->obj);
  PyObject_DEL(self);
}


static PyObject *
pysl_slangobject_getattr(PySL_SLangObject_Object *self, char *name)
{
  PyObject *name_str = NULL;
  PyObject *attr = NULL;
  char *cmd = NULL;

  /* Get attributes beginning with "__" using the standard mechanism.
   * (If we don't do this, 'help(foo)' where foo is a SLangObject
   * instance yields S-Lang errors.) */
  if (!strncmp(name, "__", 2)) {
    if (NULL == (name_str = PyString_FromString(name)))
      return NULL;

    attr = PyObject_GenericGetAttr((PyObject*)self, name_str);
    Py_DECREF(name_str);

    return attr;
  }

  if (-1 == SLang_push_anytype(self->obj) ||
      NULL == (cmd = libpysl_strcatn(3, "$0 = (); $0.", name, ";")) ||
      -1 == SLang_load_string(cmd)) {
    libpysl_slang_to_python_error();
    goto error;
  }

  attr = libpysl_pop_pyobject();

 error:
  free(cmd);

  return attr;
}


static int
pysl_slangobject_setattr(PySL_SLangObject_Object *self, char *name,
			 PyObject *value)
{
  PyObject *name_str = NULL;
  char *cmd = NULL;
  int rv = -1;

  /* Set attributes beginning with "__" using the standard mechanism */
  if (!strncmp(name, "__", 2)) {
    if (NULL == (name_str = PyString_FromString(name)))
      return -1;

    rv = PyObject_GenericSetAttr((PyObject*)self, name_str, value);
    Py_DECREF(name_str);

    return rv;
  }

  if (NULL == value) {
    PyErr_Format(PyExc_AttributeError,
		 "'%s' object does not support attribute deletion",
		 PySL_SLangObject_Type.tp_name);
    goto error;
  }

  if (-1 == SLang_push_anytype(self->obj) ||
      -1 == libpysl_push_pyobject(value) ||
      NULL == (cmd = libpysl_strcatn(3, "($0, $1) = (); $0.", name,
				     " = $1;")) ||
      -1 == SLang_load_string(cmd)) {
    libpysl_slang_to_python_error();
    goto error;
  }

  rv = 0;

 error:
  free(cmd);

  return rv;
}


static PyObject *
pysl_slangobject_repr(PySL_SLangObject_Object *self)
{
  if (-1 == SLang_push_anytype(self->obj) ||
      -1 == SLexecute_function(libpysl_slfunc_string)) {
    libpysl_slang_to_python_error();
    return NULL;
  }

  return libpysl_pop_pyobject();
}


static PyObject *
pysl_do_slang_unary_op(PyObject *a, const char* op)
{
  PyObject *result = NULL;
  char *cmd = NULL;

  if (-1 == libpysl_push_pyobject(a) ||
      NULL == (cmd = libpysl_strcatn(3, "$0 = (); ", op, "($0);")) ||
      -1 == SLang_load_string(cmd)) {
    libpysl_slang_to_python_error();
    goto error;
  }

  result = libpysl_pop_pyobject();

 error:
  free(cmd);

  return result;
}


static PyObject *
pysl_do_slang_binary_op(PyObject *a, PyObject *b, const char* op)
{
  PyObject *result = NULL;
  char *cmd = NULL;

  if (-1 == libpysl_push_pyobject(a) ||
      -1 == libpysl_push_pyobject(b) ||
      NULL == (cmd = libpysl_strcatn(3, "($0, $1) = (); $0 ", op, " $1;")) ||
      -1 == SLang_load_string(cmd)) {
    libpysl_slang_to_python_error();
    goto error;
  }

  result = libpysl_pop_pyobject();

 error:
  free(cmd);

  return result;
}


static PyObject *
pysl_slangobject_add(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "+");
}


static PyObject *
pysl_slangobject_subtract(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "-");
}


static PyObject *
pysl_slangobject_multiply(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "*");
}


static PyObject *
pysl_slangobject_divide(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "/");
}


static PyObject *
pysl_slangobject_remainder(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "mod");
}


static PyObject *
pysl_slangobject_power(PyObject *a, PyObject *b, PyObject *c)
{
  if (c != Py_None) {
    PyErr_Format(PyExc_TypeError,
		 "'%s' object does not support pow() 3rd argument",
		 PySL_SLangObject_Type.tp_name);
    return NULL;
  }

  return pysl_do_slang_binary_op(a, b, "^");
}


static PyObject *
pysl_slangobject_negative(PyObject *a)
{
  return pysl_do_slang_unary_op(a, "-");
}


static PyObject *
pysl_slangobject_positive(PyObject *a)
{
  return pysl_do_slang_unary_op(a, "+");
}


static PyObject *
pysl_slangobject_absolute(PyObject *a)
{
  return pysl_do_slang_unary_op(a, "abs");
}


static int
pysl_slangobject_nonzero(PyObject *a)
{
  int result;

  if (-1 == libpysl_push_pyobject(a) ||
      -1 == SLang_load_string("$0 = (); not not $0;") ||
      -1 == SLang_pop_int(&result)) {
    libpysl_slang_to_python_error();
    return -1;
  }

  return result;
}


static PyObject *
pysl_slangobject_invert(PyObject *a)
{
  return pysl_do_slang_unary_op(a, "~");
}


static PyObject *
pysl_slangobject_lshift(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "shl");
}


static PyObject *
pysl_slangobject_rshift(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "shr");
}


static PyObject *
pysl_slangobject_and(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "&");
}


static PyObject *
pysl_slangobject_xor(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "xor");
}


static PyObject *
pysl_slangobject_or(PyObject *a, PyObject *b)
{
  return pysl_do_slang_binary_op(a, b, "|");
}


static PyNumberMethods pysl_slangobject_as_number = {
  pysl_slangobject_add,		/*nb_add*/
  pysl_slangobject_subtract,	/*nb_subtract*/
  pysl_slangobject_multiply,	/*nb_multiply*/
  pysl_slangobject_divide,	/*nb_divide*/
  pysl_slangobject_remainder,	/*nb_remainder*/
  0,				/*nb_divmod*/
  pysl_slangobject_power,	/*nb_power*/
  pysl_slangobject_negative,	/*nb_negative*/
  pysl_slangobject_positive,	/*nb_positive*/
  pysl_slangobject_absolute,	/*nb_absolute*/
  pysl_slangobject_nonzero,	/*nb_nonzero*/
  pysl_slangobject_invert,	/*nb_invert*/
  pysl_slangobject_lshift,	/*nb_lshift*/
  pysl_slangobject_rshift,	/*nb_rshift*/
  pysl_slangobject_and,		/*nb_and*/
  pysl_slangobject_xor,		/*nb_xor*/
  pysl_slangobject_or,		/*nb_or*/
  0,				/*nb_coerce*/
  0,				/*nb_int*/
  0,				/*nb_long*/
  0,				/*nb_float*/
  0,				/*nb_oct*/
  0,				/*nb_hex*/
  0,				/*nb_inplace_add*/
  0,				/*nb_inplace_subtract*/
  0,				/*nb_inplace_multiply*/
  0,				/*nb_inplace_divide*/
  0,				/*nb_inplace_remainder*/
  0,				/*nb_inplace_power*/
  0,				/*nb_inplace_lshift*/
  0,				/*nb_inplace_rshift*/
  0,				/*nb_inplace_and*/
  0,				/*nb_inplace_xor*/
  0,				/*nb_inplace_or*/
  0,				/*nb_floor_divide*/
  0,				/*nb_true_divide*/
  0,				/*nb_inplace_floor_divide*/
  0,				/*nb_inplace_true_divide*/
};


static Py_ssize_t
pysl_slangobject_length(PySL_SLangObject_Object *self)
{
  int length;

  if (-1 == SLang_push_anytype(self->obj) ||
      -1 == SLexecute_function(libpysl_slfunc_length) ||
      -1 == SLang_pop_int(&length)) {
    libpysl_slang_to_python_error();
    return -1;
  }

  return (Py_ssize_t)length;
}


static PyObject *
pysl_slangobject_item(PySL_SLangObject_Object *self, Py_ssize_t index)
{
  int type;
  int length;

  if (!SAFE_TO_CAST(index, Py_ssize_t, int)) {
    PyErr_SetString(PyExc_ValueError,
		    "index is too large to be used by S-Lang");
    return NULL;
  }

  if (-1 == SLang_push_int((int)index) ||
      -1 == SLang_push_anytype(self->obj) ||
      -1 == (type = SLang_peek_at_stack()) ||
      -1 == SLdup_n(1) ||
      -1 == SLexecute_function(libpysl_slfunc_length) ||
      -1 == SLang_pop_int(&length)) {
    libpysl_slang_to_python_error();
    return NULL;
  }

  /* In iteration contexts, IndexError indicates the end of the sequence */
  if (index >= (Py_ssize_t)length) {
    if (-1 == SLdo_pop_n(2))
      libpysl_slang_to_python_error();
    else
      PyErr_SetNone(PyExc_IndexError);
    return NULL;
  }

  /* Hack to make Assoc_Type's iterable */
  if (SLANG_ASSOC_TYPE == type) {
    if (-1 == SLexecute_function(libpysl_slfunc_assoc_get_keys)) {
      libpysl_slang_to_python_error();
      return NULL;
    }
  }

  if (-1 == SLang_load_string("($1, $0) = (); $0[$1];")) {
    libpysl_slang_to_python_error();
    return NULL;
  }

  return libpysl_pop_pyobject();
}


static PySequenceMethods pysl_slangobject_as_sequence = {
  (lenfunc)pysl_slangobject_length,	/*sq_length*/
  0,					/*sq_concat*/
  0,					/*sq_repeat*/
  (ssizeargfunc)pysl_slangobject_item,	/*sq_item*/
  0,					/*sq_slice*/
  0,					/*sq_ass_item*/
  0,					/*sq_ass_slice*/
  0,					/*sq_contains*/
  0,					/*sq_inplace_concat*/
  0,					/*sq_inplace_repeat*/
};


static PyObject *
pysl_slangobject_subscript(PySL_SLangObject_Object *self, PyObject *key)
{
  if (-1 == SLang_push_anytype(self->obj) ||
      -1 == libpysl_push_pyobject(key) ||
      -1 == SLang_load_string("($0, $1) = (); $0[$1];")) {
    libpysl_slang_to_python_error();
    return NULL;
  }

  return libpysl_pop_pyobject();
}


static int
pysl_slangobject_ass_subscript(PySL_SLangObject_Object *self, PyObject *key,
			       PyObject *value)
{
  if (NULL == value) {
    PyErr_Format(PyExc_TypeError, "'%s' object does not support item deletion",
		 PySL_SLangObject_Type.tp_name);
    return -1;
  }

  if (-1 == SLang_push_anytype(self->obj) ||
      -1 == libpysl_push_pyobject(key) ||
      -1 == libpysl_push_pyobject(value) ||
      -1 == SLang_load_string("($0, $1, $2) = (); $0[$1] = $2;")) {
    libpysl_slang_to_python_error();
    return -1;
  }

  return 0;
}


static PyMappingMethods pysl_slangobject_as_mapping = {
  (lenfunc)pysl_slangobject_length,			/*mp_length*/
  (binaryfunc)pysl_slangobject_subscript,		/*mp_subscript*/
  (objobjargproc)pysl_slangobject_ass_subscript,	/*mp_ass_subscript*/
};


static PyObject *
pysl_slangobject_call(PySL_SLangObject_Object *self, PyObject *args,
		      PyObject *kwargs)
{
  SLang_Ref_Type *ref = NULL;
  SLang_Name_Type *nt = NULL;
  PyObject *obj = NULL;
  PyObject *rtn_obj = NULL;
  Py_ssize_t nargs;
  Py_ssize_t nrtn;
  Py_ssize_t i;

  if ((NULL != kwargs) && (0 != PyObject_Size(kwargs))) {
    PyErr_Format(PyExc_TypeError,
		 "'%s' object cannot be called with keyword arguments",
		 PySL_SLangObject_Type.tp_name);
    goto error;
  }

  if (-1 == SLang_push_anytype(self->obj) ||
      -1 == SLang_pop_ref(&ref) ||
      NULL == (nt = SLang_get_fun_from_ref(ref))) {
    libpysl_slang_to_python_error();
    goto error;
  }

  nargs = PyTuple_Size(args);

  /* We cast to unsigned int in calls to SLdo_pop_n() below */
  if (!SAFE_TO_CAST(nargs, Py_ssize_t, unsigned int)) {
    PyErr_SetString(PyExc_ValueError,
		    "too many arguments to pass to S-Lang");
    goto error;;
  }

  nrtn = (Py_ssize_t)SLstack_depth();

  /*
   * Push arguments onto stack
   */

  if (-1 == SLang_start_arg_list()) {
    libpysl_slang_to_python_error();
    goto error;
  }

  for (i = 0; i < nargs; i++) {
    if (NULL == (obj = PyTuple_GetItem(args, i)) ||
	-1 == libpysl_push_pyobject(obj))
      {
	/* Remove the arguments we've already pushed onto the stack */
	SLdo_pop_n((unsigned int)i);

	libpysl_slang_to_python_error();
	goto error;
      }
  }

  if (-1 == SLang_end_arg_list()) {
    libpysl_slang_to_python_error();
    goto error;
  }

  /*
   * Execute the function
   */

  if (-1 == SLexecute_function(nt)) {
    libpysl_slang_to_python_error();
    goto error;
  }

  /*
   * Collect and return the return values
   */

  nrtn = (Py_ssize_t)SLstack_depth() - nrtn;

  if (nrtn < 1) {

    /* Case 1: no return value */

    Py_INCREF(Py_None);
    rtn_obj = Py_None;

  } else if (nrtn == 1) {

    /* Case 2: one return value */

    if (NULL == (rtn_obj = libpysl_pop_pyobject())) {
      libpysl_slang_to_python_error();
      goto error;
    }

  } else {

    /* Case 3: more than one return value */

    if (NULL == (rtn_obj = PyTuple_New(nrtn))) {
      SLdo_pop_n((unsigned int)nrtn);
      libpysl_slang_to_python_error();
      goto error;
    }

    for (i = nrtn - 1; i >= 0; ) { /* i decremented in if test */
      if (NULL == (obj = libpysl_pop_pyobject()) ||
	  PyTuple_SetItem(rtn_obj, i--, obj))
	{
	  SLdo_pop_n((unsigned int)(i+1));
	  Py_DECREF(rtn_obj);
	  libpysl_slang_to_python_error();
	  goto error;
	}
    }

  }

 error:
  SLang_free_ref(ref);
  SLang_free_function(nt);

  return rtn_obj;
}


static PyObject *
pysl_slangobject_richcompare(PyObject *a, PyObject *b, int op)
{
  PyObject *result = NULL;

  switch (op) {

  case Py_LT:
    result = pysl_do_slang_binary_op(a, b, "<");
    break;

  case Py_LE:
    result = pysl_do_slang_binary_op(a, b, "<=");
    break;

  case Py_EQ:
    result = pysl_do_slang_binary_op(a, b, "==");
    break;

  case Py_NE:
    result = pysl_do_slang_binary_op(a, b, "!=");
    break;

  case Py_GT:
    result = pysl_do_slang_binary_op(a, b, ">");
    break;

  case Py_GE:
    result = pysl_do_slang_binary_op(a, b, ">=");
    break;

  default:
    Py_INCREF(Py_NotImplemented);
    result = Py_NotImplemented;
    break;

  }

  return result;
}


PyTypeObject PySL_SLangObject_Type = {
  PyObject_HEAD_INIT(NULL)
  0,						/*ob_size*/
  "pysl.SLangObject",				/*tp_name*/
  sizeof(PySL_SLangObject_Object),		/*tp_basicsize*/
  0,						/*tp_itemsize*/
  (destructor)pysl_slangobject_dealloc,		/*tp_dealloc*/
  0,						/*tp_print*/
  (getattrfunc)pysl_slangobject_getattr,	/*tp_getattr*/
  (setattrfunc)pysl_slangobject_setattr,	/*tp_setattr*/
  0,						/*tp_compare*/
  (reprfunc)pysl_slangobject_repr,		/*tp_repr*/
  &pysl_slangobject_as_number,			/*tp_as_number*/
  &pysl_slangobject_as_sequence,		/*tp_as_sequence*/
  &pysl_slangobject_as_mapping,			/*tp_as_mapping*/
  0,						/*tp_hash */
  (ternaryfunc)pysl_slangobject_call,		/*tp_call*/
  0,						/*tp_str*/
  0,						/*tp_getattro*/
  0,						/*tp_setattro*/
  0,						/*tp_as_buffer*/
  0,						/*tp_flags*/
  "S-Lang object wrapper",			/*tp_doc*/
  0,						/*tp_traverse*/
  0,						/*tp_clear*/
  pysl_slangobject_richcompare,			/*tp_richcompare*/
};



/******************************************************************************
 *
 * S-Lang PyObject type
 *
 *****************************************************************************/



typedef struct {
  PyObject *obj;
} SLPy_PyObject_Object;


SLtype SLPy_PyObject_Type = SLANG_UNDEFINED_TYPE;


static void
slpy_free_pyobject(SLPy_PyObject_Object *slobj)
{
  Py_XDECREF(slobj->obj);
  SLfree((char*)slobj);
}


/*
 * Increments the reference count of obj.
 */
SLang_MMT_Type *
slpy_allocate_pyobject(PyObject *obj)
{
  SLPy_PyObject_Object *slobj = NULL;
  SLang_MMT_Type *mmt = NULL;

  if (NULL == obj) {
    SLang_verror(SL_Internal_Error,
		 "NULL pointer passed to slpy_allocate_pyobject()");
    return NULL;
  }

  slobj = (SLPy_PyObject_Object*)SLmalloc(sizeof(SLPy_PyObject_Object));
  if (NULL == slobj)
    return NULL;

  Py_INCREF(obj);
  slobj->obj = obj;

  if (NULL == (mmt = SLang_create_mmt(SLPy_PyObject_Type, (VOID_STAR)slobj))) {
    slpy_free_pyobject(slobj);
    return NULL;
  }

  return mmt;
}


int
slpy_pop_pyobject(PyObject **obj, SLang_MMT_Type **mmt)
{
  SLPy_PyObject_Object *slobj = NULL;

  if (NULL == (*mmt = SLang_pop_mmt(SLPy_PyObject_Type)))
    return -1;

  slobj = (SLPy_PyObject_Object*)SLang_object_from_mmt(*mmt);
  *obj = slobj->obj;   /* FIXME: need to check for NULL? */

  return 0;
}


static int
slpy_push_pyobject(PyObject *obj)
{
  SLang_MMT_Type *mmt = NULL;

  if (NULL == (mmt = slpy_allocate_pyobject(obj)))
    return -1;

  if (-1 == SLang_push_mmt(mmt)) {
    SLang_free_mmt(mmt);
    return -1;
  }

  return 0;
}


static void
slpy_pyobject_destroy(SLtype type, VOID_STAR o)
{
  SLPy_PyObject_Object *slobj = (SLPy_PyObject_Object*)o;
  (void) type;

  slpy_free_pyobject(slobj);
}


static char *
slpy_pyobject_string(SLtype type, VOID_STAR o)
{
  SLang_MMT_Type *mmt = *(SLang_MMT_Type**)o;
  SLPy_PyObject_Object *slobj = NULL;
  PyObject *str_obj = NULL;
  char *str = NULL;

  (void) type;

  slobj = (SLPy_PyObject_Object*)SLang_object_from_mmt(mmt);

  if (NULL == (str_obj = PyObject_Repr(slobj->obj))) {
    libpysl_python_to_slang_error();
    return NULL;
  }

  str = SLmake_string(PyString_AsString(str_obj));

  Py_DECREF(str_obj);
  return str;
}


static int
slpy_pyobject_length(SLtype type, VOID_STAR o, unsigned int *length)
{
  SLang_MMT_Type *mmt = *(SLang_MMT_Type**)o;
  SLPy_PyObject_Object *slobj = NULL;
  Py_ssize_t len;

  slobj = (SLPy_PyObject_Object*)SLang_object_from_mmt(mmt);

  if (-1 == (len = PyObject_Length(slobj->obj))) {
    libpysl_python_to_slang_error();
    return -1;
  }

  if (!SAFE_TO_CAST(len, Py_ssize_t, unsigned int)) {
    SLang_verror(SL_LimitExceeded_Error,
		 "object size is too large to be used by S-Lang");
    return -1;
  }

  *length = (unsigned int)len;

  return 0;
}


static int
slpy_pyobject_push(SLtype type, VOID_STAR p)
{
  SLang_MMT_Type *mmt = *(SLang_MMT_Type**)p;
  SLPy_PyObject_Object *slobj = NULL;

  (void) type;

  slobj = (SLPy_PyObject_Object*)SLang_object_from_mmt(mmt);

  if (-1 == libpysl_push_pyobject(slobj->obj)) {
    libpysl_python_to_slang_error();
    return -1;
  }

  /* We don't need to free the MMT, because S-Lang expects the push function
   * to increase its reference count and therefore decrements it after the
   * push */

  return 0;
}


/*
 * I'm not sure when this would ever be called ...
 */
static int
slpy_pyobject_pop(SLtype type, VOID_STAR p)
{
  PyObject *obj = NULL;
  SLang_MMT_Type *mmt = NULL;

  (void) type;

  if (NULL == (obj = libpysl_pop_pyobject())) {
    libpysl_python_to_slang_error();
    return -1;
  }

  mmt = slpy_allocate_pyobject(obj);
  Py_DECREF(obj);
  if (NULL == mmt)
    return -1;

  /* SLang_create_mmt() (which is called by slpy_allocate_pyobject()) leaves
   * the reference count of the new MMT set to zero, so we need to manually
   * increment it. */
  SLang_inc_mmt(mmt);

  *(SLang_MMT_Type**)p = mmt;

  return 0;
}


static int
slpy_pyobject_sget(SLtype type, char *name)
{
  PyObject *obj = NULL;
  SLang_MMT_Type *mmt = NULL;
  PyObject *attr = NULL;
  int ret = -1;  /* Return value */

  (void) type;

  if (-1 == slpy_pop_pyobject(&obj, &mmt))
    goto error;

  if (NULL == (attr = PyObject_GetAttrString(obj, name)) ||
      -1 == libpysl_push_pyobject(attr)) {
    libpysl_python_to_slang_error();
    goto error;
  }

  ret = 0;

 error:
  SLang_free_mmt(mmt);
  Py_XDECREF(attr);

  return ret;
}


static int
slpy_pyobject_sput(SLtype type, char *name)
{
  PyObject *obj = NULL;
  SLang_MMT_Type *mmt = NULL;
  PyObject *attr = NULL;
  int ret = -1;  /* Return value */

  (void) type;

  if (-1 == slpy_pop_pyobject(&obj, &mmt))
    goto error;

  if (NULL == (attr = libpysl_pop_pyobject()) ||
      -1 == PyObject_SetAttrString(obj, name, attr)) {
    libpysl_python_to_slang_error();
    goto error;
  }

  ret = 0;

 error:
  SLang_free_mmt(mmt);
  Py_XDECREF(attr);

  return ret;
}


static PyObject *
slpy_pop_array_index_pyobject(unsigned int num_indices)
{
  PyObject *key = NULL;
  PyObject *index = NULL;
  Py_ssize_t num;
  Py_ssize_t i;

  if (!SAFE_TO_CAST(num_indices, unsigned int, Py_ssize_t)) {
    SLang_verror(SL_LimitExceeded_Error,
		 "too many indices to be used by Python");
    return NULL;
  }

  num = (Py_ssize_t)num_indices;

  if (num == 1) {

    if (NULL == (key = libpysl_pop_pyobject())) {
      libpysl_python_to_slang_error();
      return NULL;
    }

  } else {

    if (NULL == (key = PyTuple_New(num))) {
      libpysl_python_to_slang_error();
      return NULL;
    }

    for (i = num; i > 0; ) { /* i decremented in if test */
      if (NULL == (index = libpysl_pop_pyobject()) ||
	  PyTuple_SetItem(key, --i, index)) {
	Py_DECREF(key);
	libpysl_python_to_slang_error();
	return NULL;
      }
    }

  }

  return key;
}


static int
slpy_pyobject_aget(SLtype type, unsigned int num_indices)
{
  PyObject *obj = NULL;
  SLang_MMT_Type *mmt = NULL;
  PyObject *key = NULL;
  PyObject *value = NULL;
  int ret = -1;  /* Return value */

  (void) type;

  if (-1 == slpy_pop_pyobject(&obj, &mmt))
    goto error;

  if (NULL == (key = slpy_pop_array_index_pyobject(num_indices)))
    goto error;

  if (NULL == (value = PyObject_GetItem(obj, key)) ||
      -1 == libpysl_push_pyobject(value)) {
    libpysl_python_to_slang_error();
    goto error;
  }

  ret = 0;

 error:
  SLang_free_mmt(mmt);
  Py_XDECREF(key);
  Py_XDECREF(value);

  return ret;
}


static int
slpy_pyobject_aput(SLtype type, unsigned int num_indices)
{
  PyObject *obj = NULL;
  SLang_MMT_Type *mmt = NULL;
  PyObject *key = NULL;
  PyObject *value = NULL;
  int ret = -1;  /* Return value */

  (void) type;

  if (-1 == slpy_pop_pyobject(&obj, &mmt))
    goto error;

  if (NULL == (key = slpy_pop_array_index_pyobject(num_indices)))
    goto error;

  if (NULL == (value = libpysl_pop_pyobject()) ||
      -1 == PyObject_SetItem(obj, key, value)) {
    libpysl_python_to_slang_error();
    goto error;
  }

  ret = 0;

 error:
  SLang_free_mmt(mmt);
  Py_XDECREF(key);
  Py_XDECREF(value);

  return ret;
}


struct _pSLang_Foreach_Context_Type {
  PyObject *obj;
  SLang_MMT_Type *mmt;
  PyObject *iter;
};


static void
slpy_pyobject_foreach_close(SLtype type, SLang_Foreach_Context_Type *c)
{
  (void) type;

  if (NULL == c) 
    return;

  SLang_free_mmt(c->mmt);
  Py_XDECREF(c->iter);

  SLfree((char*)c);
}


static SLang_Foreach_Context_Type *
slpy_pyobject_foreach_open(SLtype type, unsigned int num)
{
  SLang_Foreach_Context_Type *c = NULL;

  if (0 != num) {
    SLdo_pop_n(num + 1);
    SLang_verror(SL_NotImplemented_Error,
		 "%s does not support 'foreach using' form",
		 SLclass_get_datatype_name(type));
    return NULL;
  }

  if (NULL == (c = ((SLang_Foreach_Context_Type*)
		    SLcalloc(1, sizeof(SLang_Foreach_Context_Type)))))
    return NULL;

  if (-1 == slpy_pop_pyobject(&(c->obj), &(c->mmt)) ||
      NULL == (c->iter = PyObject_GetIter(c->obj))) {
    slpy_pyobject_foreach_close(type, c);
    libpysl_python_to_slang_error();
    return NULL;
  }

  return c;
}


static int
slpy_pyobject_foreach(SLtype type, SLang_Foreach_Context_Type *c)
{
  PyObject *next = NULL;
  int ret = -1;  /* Return value */

  (void) type;

  if (NULL == c)
    goto error;

  if (NULL == (next = PyIter_Next(c->iter))) {
    if (!PyErr_Occurred())
      ret = 0;
    else
      libpysl_python_to_slang_error();
    goto error;
  }

  if (-1 == libpysl_push_pyobject(next)) {
    libpysl_python_to_slang_error();
    goto error;
  }

  ret = 1;

 error:
  Py_XDECREF(next);

  return ret;
}


static int
slpy_pyobject_unary(int op,
		    SLtype a_type, VOID_STAR ap, unsigned int na,
		    VOID_STAR bp)
{
  PyObject *a_obj = NULL;
  PyObject *b_obj = NULL;
  SLang_MMT_Type *b_mmt = NULL;

  int a_bool = 0;
  int decref_a = 0;
  int rv = 0;

  if (1 != na) {
    SLang_verror(SL_NotImplemented_Error,
		 "%s does not support array unary operations",
		 SLclass_get_datatype_name(SLPy_PyObject_Type));
    goto error;
  }

  if (SLPy_PyObject_Type == a_type) {
    a_obj = ((SLPy_PyObject_Object*)
	     SLang_object_from_mmt(*(SLang_MMT_Type**)ap))->obj;
  } else {
    if (-1 == SLang_push_value(a_type, ap) ||
	NULL == (a_obj = libpysl_pop_pyobject()))
      goto error;
    decref_a = 1;
  }

  switch (op) {

  case SLANG_CHS:
    b_obj = PyNumber_Negative(a_obj);
    break;

  case SLANG_NOT:
    if (-1 != (a_bool = PyObject_Not(a_obj))) {
      if (a_bool)
	b_obj = Py_True;
      else
	b_obj = Py_False;
      Py_INCREF(b_obj);
    }
    break;

  case SLANG_BNOT:
    b_obj = PyNumber_Invert(a_obj);
    break;

  case SLANG_ABS:
    b_obj = PyNumber_Absolute(a_obj);
    break;

  default:
    SLang_verror(SL_NotImplemented_Error,
		 "%s does not support requested unary operation",
		 SLclass_get_datatype_name(SLPy_PyObject_Type));
    break;

  }

  if (NULL == b_obj) {
      libpysl_python_to_slang_error();
      goto error;
  }

  if (NULL == (b_mmt = slpy_allocate_pyobject(b_obj)))
    goto error;

  /* SLang_create_mmt() (which is called by slpy_allocate_pyobject()) leaves
   * the reference count of the new MMT set to zero, so we need to manually
   * increment it. */
  SLang_inc_mmt(b_mmt);

  *(SLang_MMT_Type**)bp = b_mmt;

  rv = 1;

 error:
  if (decref_a)  Py_XDECREF(a_obj);
  Py_XDECREF(b_obj);

  return rv;
}


static int
slpy_pyobject_unary_result(int op, SLtype a, SLtype *b)
{
  (void) op;
  (void) a;

  *b = SLPy_PyObject_Type;

  return 1;
}


static int
slpy_pyobject_binary(int op,
		     SLtype a_type, VOID_STAR ap, unsigned int na,
		     SLtype b_type, VOID_STAR bp, unsigned int nb,
		     VOID_STAR cp)
{
  PyObject *a_obj = NULL;
  PyObject *b_obj = NULL;
  PyObject *c_obj = NULL;
  SLang_MMT_Type *c_mmt = NULL;

  int a_bool = 0;
  int decref_a = 0;
  int decref_b = 0;
  int rv = 0;

  if ((1 != na) || (1 != nb)) {
    SLang_verror(SL_NotImplemented_Error,
		 "%s does not support array binary operations",
		 SLclass_get_datatype_name(SLPy_PyObject_Type));
    goto error;
  }

  if (SLPy_PyObject_Type == a_type) {
    a_obj = ((SLPy_PyObject_Object*)
	     SLang_object_from_mmt(*(SLang_MMT_Type**)ap))->obj;
  } else {
    if (-1 == SLang_push_value(a_type, ap) ||
	NULL == (a_obj = libpysl_pop_pyobject()))
      goto error;
    decref_a = 1;
  }

  if (SLPy_PyObject_Type == b_type) {
    b_obj = ((SLPy_PyObject_Object*)
	     SLang_object_from_mmt(*(SLang_MMT_Type**)bp))->obj;
  } else {
    if (-1 == SLang_push_value(b_type, bp) ||
	NULL == (b_obj = libpysl_pop_pyobject()))
      goto error;
    decref_b = 1;
  }

  switch (op) {

  case SLANG_PLUS:
    c_obj = PyNumber_Add(a_obj, b_obj);
    break;

  case SLANG_MINUS:
    c_obj = PyNumber_Subtract(a_obj, b_obj);
    break;

  case SLANG_TIMES:
    c_obj = PyNumber_Multiply(a_obj, b_obj);
    break;

  case SLANG_DIVIDE:
    c_obj = PyNumber_Divide(a_obj, b_obj);
    break;

  case SLANG_EQ:
    c_obj = PyObject_RichCompare(a_obj, b_obj, Py_EQ);
    break;

  case SLANG_NE:
    c_obj = PyObject_RichCompare(a_obj, b_obj, Py_NE);
    break;

  case SLANG_GT:
    c_obj = PyObject_RichCompare(a_obj, b_obj, Py_GT);
    break;

  case SLANG_GE:
    c_obj = PyObject_RichCompare(a_obj, b_obj, Py_GE);
    break;

  case SLANG_LT:
    c_obj = PyObject_RichCompare(a_obj, b_obj, Py_LT);
    break;

  case SLANG_LE:
    c_obj = PyObject_RichCompare(a_obj, b_obj, Py_LE);
    break;

  case SLANG_POW:
    c_obj = PyNumber_Power(a_obj, b_obj, Py_None);
    break;

  case SLANG_OR:
    if (-1 != (a_bool = PyObject_IsTrue(a_obj))) {
      if (a_bool)
	c_obj = a_obj;
      else
	c_obj = b_obj;
      Py_INCREF(c_obj);
    }
    break;

  case SLANG_AND:
    if (-1 != (a_bool = PyObject_IsTrue(a_obj))) {
      if (a_bool)
	c_obj = b_obj;
      else
	c_obj = a_obj;
      Py_INCREF(c_obj);
    }
    break;

  case SLANG_BAND:
    c_obj = PyNumber_And(a_obj, b_obj);
    break;

  case SLANG_BOR:
    c_obj = PyNumber_Or(a_obj, b_obj);
    break;

  case SLANG_BXOR:
    c_obj = PyNumber_Xor(a_obj, b_obj);
    break;

  case SLANG_SHL:
    c_obj = PyNumber_Lshift(a_obj, b_obj);
    break;

  case SLANG_SHR:
    c_obj = PyNumber_Rshift(a_obj, b_obj);
    break;

  case SLANG_MOD:
    c_obj = PyNumber_Remainder(a_obj, b_obj);
    break;

  default:
    SLang_verror(SL_NotImplemented_Error,
		 "%s does not support requested binary operation",
		 SLclass_get_datatype_name(SLPy_PyObject_Type));
    break;

  }

  if (NULL == c_obj) {
      libpysl_python_to_slang_error();
      goto error;
  }

  if (NULL == (c_mmt = slpy_allocate_pyobject(c_obj)))
    goto error;

  /* SLang_create_mmt() (which is called by slpy_allocate_pyobject()) leaves
   * the reference count of the new MMT set to zero, so we need to manually
   * increment it. */
  SLang_inc_mmt(c_mmt);

  *(SLang_MMT_Type**)cp = c_mmt;

  rv = 1;

 error:
  if (decref_a)  Py_XDECREF(a_obj);
  if (decref_b)  Py_XDECREF(b_obj);
  Py_XDECREF(c_obj);

  return rv;
}


static int
slpy_pyobject_binary_result(int op, SLtype a, SLtype b, SLtype *c)
{
  (void) op;
  (void) a;
  (void) b;

  *c = SLPy_PyObject_Type;

  return 1;
}


static int
slpy_register_pyobject_type(void)
{
  SLang_Class_Type *cl = NULL;

  if (SLANG_UNDEFINED_TYPE != SLPy_PyObject_Type)
    return 0;

  if (NULL == (cl = SLclass_allocate_class("PyObject")))
    return -1;

  if (-1 == SLclass_set_destroy_function(cl, slpy_pyobject_destroy) ||
      -1 == SLclass_set_string_function(cl, slpy_pyobject_string) ||
      -1 == SLclass_set_length_function(cl, slpy_pyobject_length) ||
      -1 == SLclass_set_push_function(cl, slpy_pyobject_push) ||
      -1 == SLclass_set_pop_function(cl, slpy_pyobject_pop) ||
      -1 == SLclass_set_sget_function(cl, slpy_pyobject_sget) ||
      -1 == SLclass_set_sput_function(cl, slpy_pyobject_sput) ||
      -1 == SLclass_set_aget_function(cl, slpy_pyobject_aget) ||
      -1 == SLclass_set_aput_function(cl, slpy_pyobject_aput) ||
      -1 == SLclass_set_foreach_functions(cl, slpy_pyobject_foreach_open,
					  slpy_pyobject_foreach,
					  slpy_pyobject_foreach_close) ||
      -1 == SLclass_register_class(cl, SLANG_VOID_TYPE,
				   sizeof(SLPy_PyObject_Object),
				   SLANG_CLASS_TYPE_MMT)) {
    SLfree((char*)cl);
    return -1;
  }

  SLPy_PyObject_Type = SLclass_get_class_id(cl);

  if (-1 == SLclass_add_unary_op(SLPy_PyObject_Type, slpy_pyobject_unary,
				 slpy_pyobject_unary_result) ||
      -1 == SLclass_add_binary_op(SLANG_VOID_TYPE, SLPy_PyObject_Type,
				  slpy_pyobject_binary,
				  slpy_pyobject_binary_result) ||
      -1 == SLclass_add_binary_op(SLPy_PyObject_Type, SLANG_VOID_TYPE,
				  slpy_pyobject_binary,
				  slpy_pyobject_binary_result) ||
      -1 == SLclass_add_binary_op(SLPy_PyObject_Type, SLPy_PyObject_Type,
				  slpy_pyobject_binary,
				  slpy_pyobject_binary_result))
    return -1;

  return 0;
}



/******************************************************************************
 *
 * Python to S-Lang data conversion routines
 *
 *****************************************************************************/



/*
 * Create a S-Lang object from a NumPy array scalar.
 */
static int
libpysl_push_array_scalar(PyObject *obj)
{
  char cval;
  unsigned char ucval;
  short sval;
  unsigned short usval;
  int ival;
  unsigned int uival;
  long lval;
  unsigned long ulval;
#ifdef HAVE_LONG_LONG
  long long llval;
  unsigned long long ullval;
#endif
  float fval;
  double dval;
  npy_cfloat cfval;
  npy_cdouble cdval;
  char *strval = NULL;

  int status = -1;

  if (NULL == obj) {
    PyErr_SetString(PyExc_SystemError,
		    "attempted to create S-Lang object from NULL pointer");
    return -1;
  }

  if (PyArray_IsScalar(obj, Byte)) {

    PyArray_ScalarAsCtype(obj, &cval);
    status = SLang_push_char(cval);

  } else if (PyArray_IsScalar(obj, Bool) || PyArray_IsScalar(obj, UByte)) {

    PyArray_ScalarAsCtype(obj, &ucval);
    status = SLang_push_uchar(ucval);

  } else if (PyArray_IsScalar(obj, Short)) {

    PyArray_ScalarAsCtype(obj, &sval);
    status = SLang_push_short(sval);

  } else if (PyArray_IsScalar(obj, UShort)) {

    PyArray_ScalarAsCtype(obj, &usval);
    status = SLang_push_ushort(usval);

  } else if (PyArray_IsScalar(obj, Int)) {

    PyArray_ScalarAsCtype(obj, &ival);
    status = SLang_push_int(ival);

  } else if (PyArray_IsScalar(obj, UInt)) {

    PyArray_ScalarAsCtype(obj, &uival);
    status = SLang_push_uint(uival);

  } else if (PyArray_IsScalar(obj, Long)) {

    PyArray_ScalarAsCtype(obj, &lval);
    status = SLang_push_long(lval);

  } else if (PyArray_IsScalar(obj, ULong)) {

    PyArray_ScalarAsCtype(obj, &ulval);
    status = SLang_push_ulong(ulval);

#ifdef HAVE_LONG_LONG
  } else if (PyArray_IsScalar(obj, LongLong)) {

    PyArray_ScalarAsCtype(obj, &llval);
    status = SLang_push_long_long(llval);

  } else if (PyArray_IsScalar(obj, ULongLong)) {

    PyArray_ScalarAsCtype(obj, &ullval);
    status = SLang_push_ulong_long(ullval);

#endif /* HAVE_LONG_LONG */
  } else if (PyArray_IsScalar(obj, Float)) {

    PyArray_ScalarAsCtype(obj, &fval);
    status = SLang_push_float(fval);

  } else if (PyArray_IsScalar(obj, Double)) {

    PyArray_ScalarAsCtype(obj, &dval);
    status = SLang_push_double(dval);

  } else if (PyArray_IsScalar(obj, CFloat)) {

    PyArray_ScalarAsCtype(obj, &cfval);
    status = SLang_push_complex((double)(cfval.real), (double)(cfval.imag));

  } else if (PyArray_IsScalar(obj, CDouble)) {

    PyArray_ScalarAsCtype(obj, &cdval);
    status = SLang_push_complex(cdval.real, cdval.imag);

  } else if (PyArray_IsScalar(obj, String)) {

    PyArray_ScalarAsCtype(obj, &strval);
    status = SLang_push_string(strval);

  } else {

    status = slpy_push_pyobject(obj);

  }

  return status;
}


/*
 * Free a NumPy array wrapped by a S-Lang array.
 */
static void
libpysl_free_wrapped_numpyarray(SLang_Array_Type *sl_array)
{
  Py_XDECREF((PyObject*)(sl_array->client_data));
}


/*
 * Create a S-Lang array from a NumPy array.
 */
static int
libpysl_push_array(PyObject *array)
{
  SLang_Array_Type *sl_array = NULL;
  int numpy_type;
  SLtype sl_type;
  unsigned int num_dims;
  SLindex_Type dims[NPY_MAXDIMS];
  unsigned int i;

  if (NULL == array) {
    PyErr_SetString(PyExc_SystemError,
		    "attempted to create S-Lang array from NULL pointer");
    return -1;
  }

  numpy_type = PyArray_TYPE(array);

  switch (numpy_type) {

  case NPY_BYTE:
    sl_type = SLANG_CHAR_TYPE;
    break;
  case NPY_BOOL:
    /* Fall through */
  case NPY_UBYTE:
    sl_type = SLANG_UCHAR_TYPE;
    break;
  case NPY_SHORT:
    sl_type = SLANG_SHORT_TYPE;
    break;
  case NPY_USHORT:
    sl_type = SLANG_USHORT_TYPE;
    break;
  case NPY_INT:
    sl_type = SLANG_INT_TYPE;
    break;
  case NPY_UINT:
    sl_type = SLANG_UINT_TYPE;
    break;
  case NPY_LONG:
    sl_type = SLANG_LONG_TYPE;
    break;
  case NPY_ULONG:
    sl_type = SLANG_ULONG_TYPE;
    break;
  case NPY_LONGLONG:
    sl_type = SLANG_LLONG_TYPE;
    break;
  case NPY_ULONGLONG:
    sl_type = SLANG_ULLONG_TYPE;
    break;
  case NPY_FLOAT:
    sl_type = SLANG_FLOAT_TYPE;
    break;
  case NPY_DOUBLE:
    sl_type = SLANG_DOUBLE_TYPE;
    break;
  case NPY_CFLOAT:
    numpy_type = NPY_CDOUBLE;
    /* Fall through */
  case NPY_CDOUBLE:
    sl_type = SLANG_COMPLEX_TYPE;
    break;
  default:
    /* Send all other arrays through as S-Lang PyObjects, since they'll
     * probably be most useful that way */
    return slpy_push_pyobject(array);
  }

  /* Ensure we have a contiguous array of appropriate type.  The original
   * array will be DECREFed somewhere up the call chain, so we don't need to
   * do it here. */
  if (NULL == (array = PyArray_ContiguousFromAny(array, numpy_type, 0, 0)))
    return -1;

  /* Cast number of dimensions from int to unsigned int and each dimension
   * from npy_intp to SLindex_Type */

  num_dims = (unsigned int)PyArray_NDIM(array);

  for (i = 0; i < num_dims; i++) {
    if (!SAFE_TO_CAST(PyArray_DIM(array, i), npy_intp, SLindex_Type)) {
      PyErr_SetString(PyExc_ValueError,
		      "array dimension is too large for S-Lang array");
      Py_DECREF(array);
      return -1;
    }

    dims[i] = (SLindex_Type)PyArray_DIM(array, i);
  }

  if (NULL == (sl_array = SLang_create_array(sl_type, 0, PyArray_DATA(array),
					     dims, num_dims))) {
    Py_DECREF(array);
    return -1;
  }

  /* Let S-Lang DECREF the array when it's done with it */
  sl_array->free_fun = libpysl_free_wrapped_numpyarray;
  sl_array->client_data = array;

  return SLang_push_array(sl_array, 1);
}


/*
 * Convert a Python object to an appropriate S-Lang object and push it onto
 * the S-Lang stack.
 */
int
libpysl_push_pyobject(PyObject *obj)
{
  long lval;
#ifdef HAVE_LONG_LONG
  long long llval;
#endif
  PyObject *scalar = NULL;
  int status = -1;

  if (NULL == obj) {

    PyErr_SetString(PyExc_SystemError,
		    "attempted to push NULL pointer on to S-Lang stack");

  } else if (PyObject_TypeCheck(obj, &PySL_SLangObject_Type)) {

    status = SLang_push_anytype(((PySL_SLangObject_Object*)obj)->obj);

  } else if (obj == Py_None) {

    status = SLang_push_null();

  } else if (PyBool_Check(obj)) {

    if (obj == Py_True)
      status = SLang_push_char(1);
    else
      status = SLang_push_char(0);

  } else if (PyArray_IsScalar(obj, Generic)) {

    /* Check for array scalar types before other Python standard
     * types, even though the former can inherit from the latter.  If
     * nothing else, this lets us test all the cases in
     * libpysl_push_array_scalar. */

    status = libpysl_push_array_scalar(obj);

  } else if (PyInt_Check(obj)) {

    status = SLang_push_long(PyInt_AsLong(obj));

  } else if (PyLong_Check(obj)) {

    /* OverflowError will be raised if the value can't fit in a long or
     * long long. */

    lval = PyLong_AsLong(obj);

    if (NULL == PyErr_Occurred() ||
	!PyErr_ExceptionMatches(PyExc_OverflowError)) {
      status = SLang_push_long(lval);
    }
#ifdef HAVE_LONG_LONG
    else {
      PyErr_Clear();
      llval = PyLong_AsLongLong(obj);

      if (NULL == PyErr_Occurred() ||
	  !PyErr_ExceptionMatches(PyExc_OverflowError)) {
	status = SLang_push_long_long(llval);
      }
#endif /* HAVE_LONG_LONG */
      else {
	PyErr_Clear();
	status = slpy_push_pyobject(obj);
      }
#ifdef HAVE_LONG_LONG
    }
#endif

  } else if (PyFloat_Check(obj)) {

    status = SLang_push_double(PyFloat_AsDouble(obj));

  } else if (PyComplex_Check(obj)) {

    status = SLang_push_complex(PyComplex_RealAsDouble(obj),
				PyComplex_ImagAsDouble(obj));

  } else if (PyString_Check(obj)) {

    status = SLang_push_string(PyString_AsString(obj));

  } else if (PyArray_Check(obj)) {

    if (PyArray_NDIM(obj) != 0)
      status = libpysl_push_array(obj);
    else if (NULL != (scalar = PyArray_ToScalar(PyArray_DATA(obj),
						(PyArrayObject*)obj))) {
      status = libpysl_push_array_scalar(scalar);
      Py_DECREF(scalar);
    }

  } else {

      /* Handle anything else as a S-Lang PyObject */
      status = slpy_push_pyobject(obj);

  }

  return status;
}



/******************************************************************************
 *
 * S-Lang to Python data conversion routines
 *
 *****************************************************************************/



/*
 * Free a S-Lang array wrapped by a Python CObject.
 */
static void
libpysl_free_wrapped_slarray(void *sl_array, void *desc)
{
  (void) desc;
  SLang_free_array((SLang_Array_Type*)sl_array);
}


/*
 * Create a NumPy array from a S-Lang array.
 */
static PyObject *
libpysl_pop_array(void)
{
  PyObject *array = NULL;
  SLang_Array_Type *sl_array = NULL;
  SLang_Any_Type *sl_obj = NULL;
  PyObject *sl_array_cobject = NULL;
  SLtype sl_type;
  int numpy_type;
  int ndim;
  npy_intp dims[SLARRAY_MAX_DIMS];
  int i;

  if (SLANG_ARRAY_TYPE != SLang_peek_at_stack()) {
    PyErr_SetString(PyExc_SystemError,
		    "attempted to create array without Array_Type on S-Lang "
		    "stack");
    return NULL;
  }

  if (-1 == SLang_pop_array(&sl_array, 0))
    return NULL;

  sl_type = sl_array->data_type;

  switch (sl_type) {

  case SLANG_CHAR_TYPE:
    numpy_type = NPY_BYTE;
    break;
  case SLANG_UCHAR_TYPE:
    numpy_type = NPY_UBYTE;
    break;
  case SLANG_SHORT_TYPE:
    numpy_type = NPY_SHORT;
    break;
  case SLANG_USHORT_TYPE:
    numpy_type = NPY_USHORT;
    break;
  case SLANG_INT_TYPE:
    numpy_type = NPY_INT;
    break;
  case SLANG_UINT_TYPE:
    numpy_type = NPY_UINT;
    break;
  case SLANG_LONG_TYPE:
    numpy_type = NPY_LONG;
    break;
  case SLANG_ULONG_TYPE:
    numpy_type = NPY_ULONG;
    break;
  case SLANG_LLONG_TYPE:
    numpy_type = NPY_LONGLONG;
    break;
  case SLANG_ULLONG_TYPE:
    numpy_type = NPY_ULONGLONG;
    break;
  case SLANG_FLOAT_TYPE:
    numpy_type = NPY_FLOAT;
    break;
  case SLANG_DOUBLE_TYPE:
    numpy_type = NPY_DOUBLE;
    break;
  case SLANG_COMPLEX_TYPE:
    numpy_type = NPY_CDOUBLE;
    break;
  default:
    /* Send all other arrays through as Python SLangObjects, since they'll
     * probably be most useful that way */
    if (-1 == SLang_push_array(sl_array, 1) ||
	-1 == SLang_pop_anytype(&sl_obj) ||
	NULL == (array = (PyObject*)PyObject_New(PySL_SLangObject_Object,
						 &PySL_SLangObject_Type))) {
      SLang_free_anytype(sl_obj);
      return NULL;
    }

    ((PySL_SLangObject_Object*)array)->obj = sl_obj;
    return array;

  }

  /* Cast number of dimensions from unsigned int to int and each dimension
   * from SLindex_Type to npy_intp */

  if (!SAFE_TO_CAST(sl_array->num_dims, unsigned int, int)) {
    PyErr_SetString(PyExc_ValueError, "too many dimensions for NumPy array");
    return NULL;
  }
  ndim = (int)(sl_array->num_dims);

  for (i = 0; i < ndim; i++) {
    if (!SAFE_TO_CAST(sl_array->dims[i], SLindex_Type, npy_intp)) {
      PyErr_SetString(PyExc_ValueError,
		      "array dimension is too large for NumPy array");
      return NULL;
    }

    dims[i] = (npy_intp)(sl_array->dims[i]);
  }

  if ((NULL == (array = PyArray_SimpleNewFromData(ndim, dims, numpy_type,
						  sl_array->data))) ||
      (NULL ==
       (sl_array_cobject =
	PyCObject_FromVoidPtrAndDesc(sl_array,
				     (void*)libpysl_free_wrapped_slarray,
				     libpysl_free_wrapped_slarray)))) {
    SLang_free_array(sl_array);
    Py_XDECREF(array);
    return NULL;
  }

  /* Let Python free the array when it's done with it */
  PyArray_BASE(array) = sl_array_cobject;

  return array;
}


/*
 * Pop a S-Lang object off the S-Lang stack and convert it to an appropriate
 * Python object.
 */
PyObject *
libpysl_pop_pyobject(void)
{
  PyObject *obj = NULL;
  PyArray_Descr *descr = NULL;
  SLang_MMT_Type *mmt = NULL;
  int sl_type;  /* int because it holds result of SLang_peek_at_stack */
  char cval;
  unsigned char ucval;
  short sval;
  unsigned short usval;
  int ival;
  unsigned int uival;
  long lval;
  unsigned long ulval;
#ifdef HAVE_LONG_LONG
  long long llval;
  unsigned long long ullval;
#endif
  float fval;
  double dval;
  npy_cdouble cdval;
  char *strval = NULL;
  SLang_Any_Type *val = NULL;

  if (-1 == (sl_type = SLang_peek_at_stack())) {
    PyErr_SetString(PyExc_SystemError,
		    "attempted to pop object off empty S-Lang stack");
    return NULL;
  }

  if (sl_type == SLPy_PyObject_Type) {
    if (-1 != slpy_pop_pyobject(&obj, &mmt)) {
      Py_INCREF(obj);
      SLang_free_mmt(mmt);
    }
    return obj;
  }

  switch (sl_type) {

  case SLANG_NULL_TYPE:
    if (-1 != SLang_pop_null()) {
      Py_INCREF(Py_None);
      obj = Py_None;
    }
    break;

  case SLANG_CHAR_TYPE:
    if (-1 != SLang_pop_char(&cval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_BYTE)))
      obj = PyArray_Scalar(&cval, descr, NULL);
    break;

  case SLANG_UCHAR_TYPE:
    if (-1 != SLang_pop_uchar(&ucval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_UBYTE)))
      obj = PyArray_Scalar(&ucval, descr, NULL);
    break;

  case SLANG_SHORT_TYPE:
    if (-1 != SLang_pop_short(&sval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_SHORT)))
      obj = PyArray_Scalar(&sval, descr, NULL);
    break;

  case SLANG_USHORT_TYPE:
    if (-1 != SLang_pop_ushort(&usval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_USHORT)))
      obj = PyArray_Scalar(&usval, descr, NULL);
    break;

  case SLANG_INT_TYPE:
    if (-1 != SLang_pop_int(&ival) &&
	NULL != (descr = PyArray_DescrFromType(NPY_INT)))
      obj = PyArray_Scalar(&ival, descr, NULL);
    break;

  case SLANG_UINT_TYPE:
    if (-1 != SLang_pop_uint(&uival) &&
	NULL != (descr = PyArray_DescrFromType(NPY_UINT)))
      obj = PyArray_Scalar(&uival, descr, NULL);
    break;

  case SLANG_LONG_TYPE:
#ifndef HAVE_LONG_LONG
    /* Fall through */
  case SLANG_LLONG_TYPE:
#endif
    if (-1 != SLang_pop_long(&lval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_LONG)))
      obj = PyArray_Scalar(&lval, descr, NULL);
    break;

  case SLANG_ULONG_TYPE:
#ifndef HAVE_LONG_LONG
    /* Fall through */
  case SLANG_ULLONG_TYPE:
#endif
    if (-1 != SLang_pop_ulong(&ulval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_ULONG)))
      obj = PyArray_Scalar(&ulval, descr, NULL);
    break;

#ifdef HAVE_LONG_LONG
  case SLANG_LLONG_TYPE:
    if (-1 != SLang_pop_long_long(&llval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_LONGLONG)))
      obj = PyArray_Scalar(&llval, descr, NULL);
    break;

  case SLANG_ULLONG_TYPE:
    if (-1 != SLang_pop_ulong_long(&ullval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_ULONGLONG)))
      obj = PyArray_Scalar(&ullval, descr, NULL);
    break;
#endif /* HAVE_LONG_LONG */

  case SLANG_FLOAT_TYPE:
    if (-1 != SLang_pop_float(&fval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_FLOAT)))
      obj = PyArray_Scalar(&fval, descr, NULL);
    break;

  case SLANG_DOUBLE_TYPE:
    if (-1 != SLang_pop_double(&dval) &&
	NULL != (descr = PyArray_DescrFromType(NPY_DOUBLE)))
      obj = PyArray_Scalar(&dval, descr, NULL);
    break;

  case SLANG_COMPLEX_TYPE:
    if (-1 != SLang_pop_complex(&(cdval.real), &(cdval.imag)) &&
	NULL != (descr = PyArray_DescrFromType(NPY_CDOUBLE)))
      obj = PyArray_Scalar(&cdval, descr, NULL);
    break;

  case SLANG_STRING_TYPE:
    if (-1 != SLang_pop_slstring(&strval)) {
      obj = PyString_FromString(strval);
      SLang_free_slstring(strval);
    }
    break;
	    
  case SLANG_ARRAY_TYPE:
    obj = libpysl_pop_array();
    break;

  default:
    /* Handle anything else as a Python SLangObject */
    if (-1 == SLang_pop_anytype(&val) ||
	NULL == (obj = (PyObject*)PyObject_New(PySL_SLangObject_Object,
					       &PySL_SLangObject_Type)))
      SLang_free_anytype(val);
    else
      ((PySL_SLangObject_Object*)obj)->obj = val;
    break;

  }

  /* PyArray_Scalar() just borrows a reference to descr, so we need to
     DECREF it */
  Py_XDECREF(descr);

  return obj;
}



/******************************************************************************
 *
 * Library initialization
 *
 *****************************************************************************/



static int init_count = 0;
static int python_is_toplevel = 1;


int
libpysl_python_is_toplevel(void)
{
  return python_is_toplevel;
}


void
libpysl_deinit(void)
{
  if (--init_count > 0)  return;

  init_count = 0;

  /* Free Python objects */
  Py_XDECREF(PySL_SLangError);
  Py_XDECREF(LibPySL_Py2SL_Error_Map);
  Py_XDECREF(LibPySL_SL2Py_Error_Map);
  PySL_SLangError = NULL;
  LibPySL_Py2SL_Error_Map = NULL;
  LibPySL_SL2Py_Error_Map = NULL;

  /* Free S-Lang functions */
  SLang_free_function(libpysl_slfunc_assoc_get_keys);
  SLang_free_function(libpysl_slfunc_length);
  SLang_free_function(libpysl_slfunc_string);
  libpysl_slfunc_assoc_get_keys = NULL;
  libpysl_slfunc_length = NULL;
  libpysl_slfunc_string = NULL;

  /* If appropriate, shut down Python */
  if (!python_is_toplevel && Py_IsInitialized())  Py_Finalize();
}


int
libpysl_init(int in_python)
{
  /* Dummy argc, argv for PySys_SetArgv */
  int argc = 1;
  char *argv[1] = {""};

  /* If we've already been initialized, just increment init_count and
     return */
  if (init_count > 0) {
    init_count++;
    return 0;
  }

  /* Clean up any previous failed attempts at initialization */
  libpysl_deinit();

  /*
   * Initialize the Python interpreter if needed
   */

  if (!in_python) {
    python_is_toplevel = 0;

    Py_Initialize();
    PySys_SetArgv(argc, argv);

    /* We need a safe default value for SLPy_PythonError in case something
     * fails before we initialize it */
    SLPy_PythonError = SL_Import_Error;
  }

  /*
   * Create the error-map dictionaries
   */

  if (NULL == (LibPySL_Py2SL_Error_Map = PyDict_New()) ||
      NULL == (LibPySL_SL2Py_Error_Map = PyDict_New()))
    return -1;

  /*
   * Create the Python SLangError exception
   */

  if (NULL == (PySL_SLangError = PyErr_NewException("pysl.SLangError", NULL,
						    NULL)))
    return -1;

  /*
   * Initialize the S-Lang interpreter if needed
   */

  if (in_python) {
    python_is_toplevel = 1;

    if (-1 == SLang_init_all() ||
	-1 == SLang_init_array_extra() ||
	-1 == SLang_init_import())
      return -1;
  }

  /*
   * Create the S-Lang PythonError exception
   */

  if (0 == SLPy_PythonError)
    if (-1 == (SLPy_PythonError = SLerr_new_exception(SL_RunTime_Error,
						      "PythonError",
						      "Python Error")))
      return -1;

  /*
   * Initialize NumPy
   */

  import_array();

  /*
   * Get pointers to needed S-Lang intrinsic functions
   */

  libpysl_slfunc_assoc_get_keys = SLang_get_function("assoc_get_keys");
  libpysl_slfunc_length = SLang_get_function("length");
  libpysl_slfunc_string = SLang_get_function("string");

  if (NULL == libpysl_slfunc_assoc_get_keys ||
      NULL == libpysl_slfunc_length ||
      NULL == libpysl_slfunc_string) {
    /* No S-Lang error is set if SLang_get_function fails, so we need to
     * throw one ourselves */
    SLang_verror(SL_Import_Error,
		 "unable to access necessary S-Lang instrinsic functions");
    return -1;
  }

  /*
   * Initialize the Python SLangObject and S-Lang PyObject types
   */

  PySL_SLangObject_Type.ob_type = &PyType_Type;

  if (-1 == slpy_register_pyobject_type())
    return -1;

  init_count++;
  return 0;
}
